home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / params / frmsearc.frm < prev    next >
Text File  |  1994-10-16  |  3KB  |  120 lines
  1. VERSION 2.00
  2. Begin Form frmSearch 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    ClientHeight    =   2415
  6.    ClientLeft      =   1725
  7.    ClientTop       =   5295
  8.    ClientWidth     =   6765
  9.    Height          =   2820
  10.    Left            =   1665
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   540
  15.    ScaleWidth      =   540
  16.    Top             =   4950
  17.    Width           =   6885
  18.    Begin CommandButton cmdCancel 
  19.       BackColor       =   &H00C0C0C0&
  20.       Cancel          =   -1  'True
  21.       Caption         =   "&Cancel"
  22.       Height          =   435
  23.       Left            =   4770
  24.       TabIndex        =   2
  25.       Top             =   930
  26.       Width           =   1425
  27.    End
  28.    Begin CommandButton cmdSelect 
  29.       BackColor       =   &H00C0C0C0&
  30.       Caption         =   "&Select"
  31.       Default         =   -1  'True
  32.       Height          =   435
  33.       Left            =   4770
  34.       TabIndex        =   1
  35.       Top             =   210
  36.       Width           =   1425
  37.    End
  38.    Begin ListBox lstAvailable 
  39.       Height          =   1980
  40.       Left            =   180
  41.       TabIndex        =   0
  42.       Top             =   210
  43.       Width           =   4275
  44.    End
  45.    Begin Shape shpShadow 
  46.       BackColor       =   &H00808080&
  47.       BackStyle       =   1  'Opaque
  48.       BorderColor     =   &H00808080&
  49.       Height          =   1890
  50.       Index           =   3
  51.       Left            =   300
  52.       Top             =   360
  53.       Width           =   4245
  54.    End
  55. End
  56. Option Explicit
  57.  
  58. Sub cmdCancel_Click ()
  59.   Unload Me
  60. End Sub
  61.  
  62. Sub cmdSelect_Click ()
  63.   ReturnValue
  64. End Sub
  65.  
  66. Sub Form_Load ()
  67.   SetDialogMenu Me
  68.   PlaceDialog frmMain, Me, DLG_STANDARD
  69.   Me.Caption = "Search for " & GetFormParam(PRF_TABLE)
  70.   LoadData
  71. End Sub
  72.  
  73. Sub LoadData ()
  74.   Dim sSQL As String
  75.   Dim sCriteria As String
  76.   Dim dbBiblio As Database
  77.   Dim snLookUp As SnapShot
  78.   ReDim sFlds(3) As String
  79.   Dim iIndex As Integer
  80.   On Error GoTo LoadData_Err
  81.   sFlds(1) = "[Company Name]"
  82.   sFlds(2) = "Author"
  83.   sFlds(3) = "Title"
  84.   Set dbBiblio = OpenDatabase(GetAppParam(PRA_DATABASE), True, True)
  85.   sSQL = "SELECT DISTINCT * FROM "
  86.   sSQL = sSQL & GetFormParam(PRF_TABLE)
  87.   sCriteria = GetFormParam(PRF_CRITERIA)
  88.   iIndex = Val(GetFormParam(PRF_INDEX))
  89.   If sCriteria <> "" Then
  90.     sCriteria = " WHERE " & sFlds(iIndex) & " LIKE " & """" & sCriteria & "*" & """"
  91.   End If
  92.   sSQL = sSQL & sCriteria
  93.   Set snLookUp = dbBiblio.CreateSnapshot(sSQL)
  94.   If snLookUp.RecordCount <> 0 Then
  95.     Do
  96.       lstAvailable.AddItem snLookUp.Fields(sFlds(iIndex))
  97.       snLookUp.MoveNext
  98.     Loop Until snLookUp.EOF
  99.   End If
  100.   snLookUp.Close
  101.   dbBiblio.Close
  102. Exit Sub
  103.  
  104. LoadData_Err:
  105.   MsgBox "Error when Loading Data!" & Chr$(13) & Chr$(13) & Error$ & "  (#" & Err & ")", MB_ICONEXCLAMATION
  106.   lstAvailable.Clear
  107. Exit Sub
  108.  
  109. End Sub
  110.  
  111. Sub lstAvailable_DblClick ()
  112.   ReturnValue
  113. End Sub
  114.  
  115. Sub ReturnValue ()
  116.   SetFormParam CStr(lstAvailable.List(lstAvailable.ListIndex)), PRF_RESULT
  117.   Unload Me
  118. End Sub
  119.  
  120.